perm filename MAD.F4[AK,LCS] blob
sn#561076 filedate 1981-02-03 generic text, type T, neo UTF8
00100 DIMENSION I(100)
00110 NS='SA '
00120 M='316AA'
00140 M=M-2
00160 MM='.X16'
00180 NX='RS'
00200 1 FORMAT(100A1)
00300 2 FORMAT(' TYPE INPUT NAME '$)
00400 3 FORMAT(' TYPE OUTPUT NAME '$)
00450 30 FORMAT(' TYPE FIRST MS NAME.EXT '$)
00500 4 FORMAT(3A5)
00550 J=0
00600 TYPE 2
00700 ACCEPT 4,NAM
00800 TYPE 3
00900 ACCEPT 4,NAM2
00950 TYPE 30
00975 ACCEPT 4,M,MM
00987 M=M-2
01000 CALL IFILE(20,NAM)
01100 CALL DEFINE(1,0,NONO,NAM2)
01200 N='G STF'
01300 WRITE(1,4)N
01400 5 READ(20,1,END=100)I
01420 IF(I(1).NE.'S'.OR.I(2).NE.'P')GO TO 8
01440 IF(J.EQ.0)GO TO 10
01460 N='SA '
01470 M=M+2
01480 WRITE(1,4)NS,M,MM
01520 WRITE(1,4)NX
01600 10 J=-1
01620 8 IF(I(1).NE.'I')GO TO 6
01700 IF(I(2).NE.'N')GO TO 6
01750 CALL SHORT(I)
01800 IF(I(3).EQ.'0')GO TO 7
01900 READ(20,1)I
02000 IF(I(1).NE.'1'.OR.I(2).NE.' ')GO TO 6
02100 GO TO 5
02200 7 READ(20,1)I
02300 CALL SHORT(I)
02400 READ(20,1)I
02500 IF(I(1).NE.'B'.OR.I(2).NE.'A')GO TO 9
02600 6 CALL SHORT(I)
02700 GO TO 5
02800 9 N='-BA/'
02900 WRITE(1,4)N
03000 GO TO 6
03020 100 M=M+2
03030 WRITE(1,4)NS,M,MM
03035 END
03040
03060 SUBROUTINE SHORT(I)
03080 DIMENSION I(1)
03100 DO 1 K=100,1,-1
03120 1 IF(I(K).NE.' ')GO TO 2
03130 K=1
03140 2 WRITE(1,3)(I(J),J=1,K)
03150 CC TYPE 3,(I(J),J=1,K)
03160 3 FORMAT(100A1)
03180 END